COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	(de gentype () (incr typecnt))
C00004 ENDMK
C⊗;
(de gentype () (incr typecnt))

(de prtty (x) (cond
  ((null (car x)) (prtty (cdr x)))
  ((null (cdr x)) (prin1 (car x)))
  (t (prin1 '/() (prtty (car x)) (prin1 '->) (prtty (cadr x))
     (prin1 '/)))))

(de unify (ta tb) (cond
  ((null (car ta)) (unify (cdr ta) tb))
  ((null (car tb)) (unify ta (cdr tb)))
  ((and (cdr ta) (cdr tb)) [(unify (car ta) (car tb))
                            (unify (cadr ta) (cadr tb))])
  ((cdr tb) (unify tb ta))
  (t (rplaca tb nil) (rplacd tb ta))))

(de lunify (ta tb)
  (if (cdr ta) (unify (car ta) tb)
      (rplaca ta tb) (rplacd ta [(gentype)])))

(de chain (tx) (if (car tx) tx (chain (cdr tx))))

(de rtype (lx) (cond
  ((atom lx) (eval lx))
  ((eq (car lx) 'lambda)
   (eval(print
 [['lambda (cadr lx) ['xcons ['list ['rtype (caddr lx)]]
                                     (chain (caadr lx))]]
          ['quote (gentype)]])))
  (t (let ((qq (rtype (car lx)))) (lunify qq (rtype (cadr lx)))
          (chain (cadr qq))))))

(de caadr (x) (caar (cdr x)))

(de type (lx)
  (setq typecnt  0) (terpri) (prtty (rtype lx))
 )